home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / fpcsrc.lha / fpc / compiler / ag68kgas.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-24  |  27KB  |  685 lines
  1. {
  2.     $Id: ag68kgas.pas,v 1.1.1.1.2.5 1998/09/14 18:57:23 carl Exp $
  3.     Copyright (c) 1998 by the FPC development team
  4.  
  5.     This unit implements an asmoutput class for MOTOROLA syntax with
  6.     Motorola 68000 (for GAS v2.52 AND HIGER)
  7.  
  8.     This program is free software; you can redistribute it and/or modify
  9.     it under the terms of the GNU General Public License as published by
  10.     the Free Software Foundation; either version 2 of the License, or
  11.     (at your option) any later version.
  12.  
  13.     This program is distributed in the hope that it will be useful,
  14.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  15.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16.     GNU General Public License for more details.
  17.  
  18.     You should have received a copy of the GNU General Public License
  19.     along with this program; if not, write to the Free Software
  20.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22.  ****************************************************************************
  23.  
  24.   What's to do:
  25.     o Verify if this actually work as indirect mode with name of variables
  26.     o write lines numbers and file names to output file
  27.     o generate debugging informations
  28. }
  29. unit ag68kgas;
  30.  
  31.     interface
  32.  
  33.     uses aasm,assemble;
  34.  
  35.     type
  36.       pm68kgasasmlist=^tm68kgasasmlist;
  37.       tm68kgasasmlist = object(tasmlist)
  38.         procedure WriteTree(p:paasmoutput);virtual;
  39.         procedure WriteAsmList;virtual;
  40.       end;
  41.  
  42.    implementation
  43.  
  44.     uses
  45.       dos,globals,systems,cobjects,m68k,
  46.       strings,files,verbose
  47. {$ifdef GDB}
  48.       ,gdb
  49. {$endif GDB}
  50.       ;
  51.  
  52.     const
  53.       line_length = 70;
  54.  
  55.     var
  56.       infile : pextfile;
  57.       includecount,lastline : longint;
  58.  
  59.     function getreferencestring(const ref : treference) : string;
  60.       var
  61.          s : string;
  62.       begin
  63.          s:='';
  64.          if ref.isintvalue then
  65.              s:='#'+tostr(ref.offset)
  66.          else
  67.            with ref do
  68.              begin
  69.                 if assigned(symbol) then
  70.                   s:=s+symbol^;
  71.  
  72.                 if offset<0 then s:=s+tostr(offset)
  73.                   else if (offset>0) then
  74.                     begin
  75.                        if (symbol=nil) then s:=tostr(offset)
  76.                        else s:=s+'+'+tostr(offset);
  77.                     end;
  78.                if (index<>R_NO) and (base=R_NO) and (direction=dir_none) then
  79.                 begin
  80.                   if (scalefactor = 1) or (scalefactor = 0) then
  81.                     s:=s+'(,'+gas_reg2str[index]+'.l)'
  82.                   else
  83.                     s:=s+'(,'+gas_reg2str[index]+'.l*'+tostr(scalefactor)+')'
  84.                 end
  85.                 else if (index=R_NO) and (base<>R_NO) and (direction=dir_inc) then
  86.                 begin
  87.                   if (scalefactor = 1) or (scalefactor = 0) then
  88.                       s:=s+'('+gas_reg2str[base]+')+'
  89.                   else
  90.                    InternalError(10002);
  91.                 end
  92.                 else if (index=R_NO) and (base<>R_NO) and (direction=dir_dec) then
  93.                 begin
  94.                   if (scalefactor = 1) or (scalefactor = 0) then
  95.                       s:=s+'-('+gas_reg2str[base]+')'
  96.                   else
  97.                    InternalError(10003);
  98.                 end
  99.                   else if (index=R_NO) and (base<>R_NO) and (direction=dir_none) then
  100.                 begin
  101.                   s:=s+'('+gas_reg2str[base]+')'
  102.                 end
  103.                   else if (index<>R_NO) and (base<>R_NO) and (direction=dir_none) then
  104.                 begin
  105.                   if (scalefactor = 1) or (scalefactor = 0) then
  106.                     s:=s+'('+gas_reg2str[base]+','+gas_reg2str[index]+'.l)'
  107.                   else
  108.                     s:=s+'('+gas_reg2str[base]+','+gas_reg2str[index]+'.l*'+tostr(scalefactor)+')';
  109.                 end;
  110.             end; { end with }
  111.          getreferencestring:=s;
  112.       end;
  113.  
  114.     function getopstr(t : byte;o : pointer) : string;
  115.  
  116.       var
  117.          hs : string;
  118.          i: tregister;
  119.  
  120.       begin
  121.          case t of
  122.             top_reg : if target_info.target=target_PalmOS then
  123.                         getopstr:=gasPalmOS_reg2str[tregister(o)]
  124.                       else
  125.                         getopstr:=gas_reg2str[tregister(o)];
  126.                top_ref : getopstr:=getreferencestring(preference(o)^);
  127.          top_reglist: begin
  128.                       hs:='';
  129.                       for i:=R_NO to R_FPSR do
  130.                       begin
  131.                         if i in tregisterlist(o^) then
  132.                          hs:=hs+gas_reg2str[i]+'/';
  133.                       end;
  134.                       delete(hs,length(hs),1);
  135.                       getopstr := hs;
  136.                     end;
  137.              top_const : getopstr:='#'+tostr(longint(o));
  138.             top_symbol :
  139.                     { compare with i386, where a symbol is considered }
  140.                     { a constant.                                     }
  141.                     begin
  142.                      hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
  143.                             move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
  144. {                           inc(byte(hs[0]));}
  145.                             if pcsymbol(o)^.offset>0 then
  146.                               hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
  147.                             else if pcsymbol(o)^.offset<0 then
  148.                               hs:=hs+tostr(pcsymbol(o)^.offset);
  149.                             getopstr:=hs;
  150.                          end;
  151.             else internalerror(10001);
  152.          end;
  153.       end;
  154.  
  155.     function getopstr_jmp(t : byte;o : pointer) : string;
  156.  
  157.       var
  158.          hs : string;
  159.  
  160.       begin
  161.          case t of
  162.             top_reg : getopstr_jmp:=gas_reg2str[tregister(o)];
  163.             top_ref : getopstr_jmp:=getreferencestring(preference(o)^);
  164.             top_const : getopstr_jmp:=tostr(longint(o));
  165.             top_symbol : begin
  166.                             hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
  167.                             move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
  168.                             if pcsymbol(o)^.offset>0 then
  169.                               hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
  170.                             else if pcsymbol(o)^.offset<0 then
  171.                               hs:=hs+tostr(pcsymbol(o)^.offset);
  172.                             getopstr_jmp:=hs;
  173.                          end;
  174.             else internalerror(10001);
  175.          end;
  176.       end;
  177.  
  178. {****************************************************************************
  179.                              T68kGASASMOUTPUT
  180.  ****************************************************************************}
  181.  
  182.     var
  183.        { different types of source lines }
  184.        n_line : byte;
  185.  
  186.     const
  187.       ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
  188.         (#9'.long'#9,'',#9'.short'#9,#9'.byte'#9);
  189.  
  190.     procedure tm68kgasasmlist.WriteTree(p:paasmoutput);
  191.     var
  192.       hp        : pai;
  193.       ch        : char;
  194.       consttyp  : tait;
  195.       s         : string;
  196.       pos,l,i   : longint;
  197.       found     : boolean;
  198. {$ifdef GDB}
  199.       funcname  : pchar;
  200.       linecount : longint;
  201. {$endif GDB}
  202.     begin
  203. {$ifdef GDB}
  204.       funcname:=nil;
  205.       linecount:=1;
  206. {$endif GDB}
  207.       hp:=pai(p^.first);
  208.       while assigned(hp) do
  209.        begin
  210.        { write debugger informations }
  211. {$ifdef GDB}
  212.          if cs_debuginfo in aktswitches then
  213.           begin
  214.             if not (hp^.typ in  [ait_external,ait_stabn,ait_stabs,ait_stab_function_name]) then
  215.              begin
  216.                if assigned(hp^.infile) and (pextfile(hp^.infile)<>infile)  then
  217.                 begin
  218.                   infile:=hp^.infile;
  219.                   inc(includecount);
  220.                   if (hp^.infile^.path^<>'') then
  221.                    begin
  222.                      AsmWriteLn(#9'.stabs "'+FixPath(hp^.infile^.path^)+'",'+tostr(n_includefile)+
  223.                                 ',0,0,Ltext'+ToStr(IncludeCount));
  224.                    end;
  225.                   AsmWriteLn(#9'.stabs "'+FixFileName(hp^.infile^.name^+hp^.infile^.ext^)+'",'+tostr(n_includefile)+
  226.                              ',0,0,Ltext'+ToStr(IncludeCount));
  227.                   AsmWriteLn('Ltext'+ToStr(IncludeCou